perm filename LOSS.LSP[TIM,LSP]6 blob sn#754849 filedate 1984-05-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (array* (notype primep 1))
C00006 ENDMK
CāŠ—;
(declare (array* (notype primep 1))
	 (special answer)
	 (fixsw t))
(eval-when (eval load compile) (setq range 1000.))
(array primep t #.(1+ range))
(fillarray 'primep '(t))

(defun set-up ()
       (do ((i 2 (1+ i)))
	   ((> i #.range) t)
	   (cond ((primep i)
		  (do ((j (+ i i) (+ j i)))
		      ((> j #.range) t)
		      (store (primep j) ()))))))

(defun list-of-primes ()
       (do ((i 2 (1+ i))
	    (a ()))
	   ((> i #.range) (nreverse a))
	   (cond ((primep i) (push i a)))))

;;; a b c
;;; d e f
;;; g h i

(defmacro neq (x . l)
	  (do ((l l (cdr l))
	       (a ()))
	      ((null l) `(and ,@a))
	      (push `(not (= ,x ,(car l))) a)))

(defmacro is-prime (x)
	  `(and (> ,x 1)(< ,x #.(1+ range))(primep ,x)))

(defun find (l)
       (do ((l (cdr l) (cdr l))
	    (a 0))
	   ((null l) ())
	   (setq a (car l))
	   (do ((l (cdr l) (cdr l))
		(b 0))
	       ((null l) ())
	       (setq b (car l))
	       (do ((l (cdr l) (cdr l))
		    (c 0) (abctotal 0))
		   ((null l) ())
		   (setq c (car l))
		   (setq abctotal (+ a b c))
		   (do ((l (cdr l) (cdr l))
			(d 0) (g 0))
		       ((null l) ())
		       (setq d (car l))
		       (setq g (- abctotal (+ a d)))
		       (cond ((and (is-prime g)
				   (= (+ b c)
				      (+ d g))
				   (neq g a b c d))
			      (do ((l (cdr l) (cdr l))
				   (e 0)(f 0)(h 0)(i 0))
				  ((null l) t)
				  (setq e (car l))
				  (setq f (- abctotal (+ d e)))
				  (setq h (- abctotal (+ b e)))
				  (setq i (- abctotal (+ c f)))
				  (cond ((and 
					  (neq f a b c d e)
					  (neq h a b c d e)
					  (neq i a b c d e)
					  (is-prime f)
					  (is-prime h)
					  (is-prime i)
					  (push 
					   `((,a ,b ,c)
					     (,d ,e ,f)
					     (,g ,h ,i)) answer))))))))))))


(defun gogogo ()
       (setq answer ())
       (set-up)(find (list-of-primes)))

(defun add-3 (x)(+ (car x)(cadr x)(caddr x)))
(defun addcol (n l)
       (+ (nth n (car l))(nth n (cadr l))(nth n (caddr l))))

(defun verify (l)
       (let ((total (add-3 (car l))))
	    (and (= total (add-3 (cadr l)))(= total (add-3 (caddr l)))
		 (= total (addcol 0 l))(= total (addcol 1 l))(= total (addcol 2 l)))))

(include "timer.lsp[tim,lsp]")

(timer timit 
	(gogogo))